home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / lzrw1kh.p < prev    next >
Encoding:
Text File  |  1993-08-25  |  5.7 KB  |  182 lines  |  [TEXT/PJMM]
  1.  
  2. {    ###################################################################   }
  3. {    ##                                                               ##   }
  4. {    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
  5. {    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
  6. {    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
  7. {    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
  8. {    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
  9. {    ##                                                               ##   }
  10. {    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
  11. {    ##                                                               ##   }
  12. {    ###################################################################   }
  13. {    ##                                                               ##   }
  14. {    ##   This unit implements the updated LZRW1/KH algoritm which    ##   }
  15. {    ##   also implements  some RLE coding  which is usefull  when    ##   }
  16. {    ##   compress files  containing  a lot  of consecutive  bytes    ##   }
  17. {    ##   having the same value.   The algoritm is not as good  as    ##   }
  18. {    ##   LZH, but can compete with Lempel-Ziff.   It's the fasted    ##   }
  19. {    ##   one I've encountered upto now.                              ##   }
  20. {    ##                                                               ##   }
  21. {    ##                                                               ##   }
  22. {    ##                                                               ##   }
  23. {    ##                                                Kurt HAENEN    ##   }
  24. {    ##                                                               ##   }
  25. {    ###################################################################   }
  26.  
  27. unit LZRW1KH;
  28.  
  29. interface
  30.  
  31.     const
  32.         BufferMaxSize = 32768;
  33.         BufferMax = BufferMaxSize - 1;
  34.         FLAG_Copied = $80;
  35.         FLAG_Compress = $40;
  36.  
  37.     type
  38.         BufferIndex = 0..BufferMax;
  39.         BufferSize = 0..BufferMaxSize;
  40.         BufferArray = packed array[BufferIndex] of BYTE;
  41.         BufferPtr = ^BufferArray;
  42.  
  43.     function LZRW1KHCompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  44.     function LZRW1KHDecompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  45.  
  46. implementation
  47.  
  48.     type
  49.         HashTable = array[0..4095] of INTEGER;
  50.         WORD = longInt;
  51.  
  52.     function LZRW1KHCompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  53.         var
  54.             Hash: HashTable;
  55.  
  56.         function GetMatch (X: BufferIndex; var Size: WORD; var Pos: BufferIndex): BOOLEAN;
  57.             var
  58.                 HashValue: WORD;
  59.         begin
  60.             HashValue := BAND(BSR(40543 * BXOR(BSL(BXOR(BSL(Source^[X], 4), Source^[X + 1]), 4), Source^[X + 2]), 4), $0FFF);
  61.  
  62.             GetMatch := FALSE;
  63.             if (Hash[HashValue] <> -1) and (X - Hash[HashValue] < 4096) then begin
  64.                 Pos := Hash[HashValue];
  65.                 Size := 0;
  66.                 while ((Size < 18) & (Source^[X + Size] = Source^[Pos + Size]) & (X + Size < SourceSize)) do
  67.                     Size := Size + 1;
  68.                 GetMatch := (Size >= 3)
  69.             end;
  70.             Hash[HashValue] := X
  71.         end;
  72.  
  73.         var
  74.             Key, Bit, Command, Size: WORD;
  75.             X, Y, Z, Pos: BufferIndex;
  76.     begin
  77.         for Key := 0 to 4095 do
  78.             Hash[Key] := -1;
  79.         Dest^[0] := FLAG_Compress;
  80.         X := 0;
  81.         Y := 3;
  82.         Z := 1;
  83.         Bit := 0;
  84.         Command := 0;
  85.         while (X < SourceSize) & (Y <= SourceSize) do begin
  86.             if (Bit > 15) then begin
  87.                 Dest^[Z] := BAND(BSR(Command, 8), $FF);
  88.                 Dest^[Z + 1] := BAND(Command, $FF);
  89.                 Z := Y;
  90.                 Bit := 0;
  91.                 Y := Y + 2;
  92.             end;
  93.             Size := 1;
  94.             while ((Source^[X] = Source^[X + Size]) & (Size < $FFF) & (X + Size < SourceSize)) do
  95.                 Size := Size + 1;
  96.             if (Size >= 16) then begin
  97.                 Dest^[Y] := 0;
  98.                 Dest^[Y + 1] := BAND(BSR(Size - 16, 8), $FF);
  99.                 Dest^[Y + 2] := BAND(Size - 16, $FF);
  100.                 Dest^[Y + 3] := Source^[X];
  101.                 Y := Y + 4;
  102.                 X := X + Size;
  103.                 Command := BSL(Command, 1) + 1;
  104.             end
  105.             else if (GetMatch(X, Size, Pos)) then begin
  106.                 Key := BSL(X - Pos, 4) + (Size - 3);
  107.                 Dest^[Y] := BAND(BSR(Key, 8), $FF);
  108.                 Dest^[Y + 1] := BAND(Key, $FF);
  109.                 Y := Y + 2;
  110.                 X := X + Size;
  111.                 Command := BSL(Command, 1) + 1;
  112.             end
  113.             else begin
  114.                 Dest^[Y] := Source^[X];
  115.                 Y := Y + 1;
  116.                 X := X + 1;
  117.                 Command := BSL(Command, 1);
  118.             end;
  119.             Bit := Bit + 1;
  120.         end;
  121.         Command := BSL(Command, 16 - Bit);
  122.         Dest^[Z] := BAND(BSR(Command, 8), $FF);
  123.         Dest^[Z + 1] := BAND(Command, $FF);
  124.         if (Y > SourceSize) then begin
  125.             BlockMove(@Source^[0], @Dest^[1], SourceSize);
  126.             Dest^[0] := FLAG_Copied;
  127.             Y := SourceSize + 1;
  128.         end;
  129.         LZRW1KHCompress := Y
  130.     end;
  131.  
  132.     function LZRW1KHDecompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  133.         var
  134.             X, Y, Pos: BufferIndex;
  135.             Command, Size, K: WORD;
  136.             Bit: BYTE;
  137.     begin
  138.         if (Source^[0] = FLAG_Copied) then begin
  139.             BlockMove(@Source^[1], @Dest^[0], SourceSize - 1);
  140.             Y := SourceSize - 1;
  141.         end
  142.         else begin
  143.             Y := 0;
  144.             X := 3;
  145.             Command := BSL(Source^[1], 8) + Source^[2];
  146.             Bit := 16;
  147.             while (X < SourceSize) do begin
  148.                 if (Bit = 0) then begin
  149.                     Command := BSL(Source^[X], 8) + Source^[X + 1];
  150.                     Bit := 16;
  151.                     X := X + 2;
  152.                 end;
  153.                 if (BAND(Command, $8000) = 0) then begin
  154.                     Dest^[Y] := Source^[X];
  155.                     Y := Y + 1;
  156.                     X := X + 1;
  157.                 end
  158.                 else begin
  159.                     Pos := BSL(Source^[X], 4) + BSR(Source^[X + 1], 4);
  160.                     if (Pos = 0) then begin
  161.                         Size := BSL(Source^[X + 1], 8) + Source^[X + 2] + 15;
  162.                         for K := 0 to Size do
  163.                             Dest^[Y + K] := Source^[X + 3];
  164.                         X := X + 4;
  165.                         Y := Y + Size + 1;
  166.                     end
  167.                     else begin
  168.                         Size := BAND(Source^[X + 1], $0F) + 2;
  169.                         for K := 0 to Size do
  170.                             Dest^[Y + K] := Dest^[Y - Pos + K];
  171.                         X := X + 2;
  172.                         Y := Y + Size + 1;
  173.                     end;
  174.                 end;
  175.                 Command := BSL(Command, 1);
  176.                 Bit := Bit - 1;
  177.             end
  178.         end;
  179.         LZRW1KHDecompress := Y
  180.     end;
  181.  
  182. end.